library(listviewer)
Error in library(listviewer) : there is no package called ‘listviewer’
(localities<-read_csv("Marks_Mox - Sheet1.csv"))
Parsed with column specification:
cols(
CatalogNumber = col_integer(),
ScientificName = col_character(),
`# of individuals` = col_character(),
Locality = col_character(),
Country = col_character(),
YearCollected = col_integer(),
Photo = col_character(),
species = col_character(),
drainage = col_character(),
river = col_character()
)
localities %>%
select(CatalogNumber,species,drainage,river)%>%
rename(cat_num=CatalogNumber)->loc
#files<-paste0("Mox_images/shapes/TU198404_",1:6,"_L.txt")
a<-readShapes(file = "Mox_images/shapes/",fields=c("landmarks.scaled","curves.scaled"))
Put landmark data into a tibble.
data<-tibble(num=attr(a$landmarks.scaled,"dimnames")[[3]],
fixedlm=array_branch(a$landmarks.scaled,margin = 3),
c_body_ant=map(a$curves.scaled,"body_ant"),
c_body_post=map(a$curves.scaled,"body_post"),
c_opercle=map(a$curves.scaled,"opercle"))
data %>%
mutate(cat_num=str_extract(num,"[0-9]+"))->data
data$cat_num<-as.integer(data$cat_num)
(data<-left_join(data,loc))
Joining, by = "cat_num"
convert curves into landmarks, evenly spaced along curves. Bind fixed and semi-landmarks together and remove duplicates.
data %>%
mutate(body_ant=map(c_body_ant,~pointsAtEvenSpacing(.x,n=10)))%>%
mutate(body_post=map(c_body_post,~pointsAtEvenSpacing(.x,n=10)))%>%
mutate(opercle=map(c_opercle,~pointsAtEvenSpacing(.x,n=5))) %>%
mutate(land_marks=pmap(list(fixedlm,body_ant,body_post,opercle),rbind))%>%
mutate(land_marks=map(land_marks,~unique(.x)))->data
Convert list (and bind several arrays together) using sapply()
new_a<-sapply(data$land_marks, I, simplify="array")
Generate plot to aid in defining sliding, semi-landmarks using AUTO mode of define.sliders(). There are 20 fixed landmarks, curves are found between landmarks 1 and 2 (anterior, dorsal body), 3 and 4 (posterior, dorsal body), and 10 and 11 (opercle)
dd<-as.data.frame(new_a[,,1])
dd$label<-1:length(dd$V1)
ggplot(dd,aes(V1,V2))+
geom_point(alpha=0.7)+
geom_text(label=dd$label,check_overlap = F,nudge_x = 1,size=3)
Generate semi-landmarks matrix for gpagen using define.sliders().
curves<-rbind(define.sliders(c(1,29:36,2)),
define.sliders(c(3,21:28,4)),
define.sliders(c(10,37:39,11)))
gpa<-gpagen(new_a,curves = curves)
|
| | 0%
|
|================== | 20%
|
|==================================== | 40%
|
|====================================================== | 60%
|
|======================================================================== | 80%
|
|==========================================================================================| 100%
gpa
Call:
gpagen(A = new_a, curves = curves)
Generalized Procrustes Analysis
with Partial Procrustes Superimposition
20 fixed landmarks
19 semilandmarks (sliders)
2-dimensional landmarks
6 GPA iterations to converge
Minimized squared Procrustes Distance used
Consensus (mean) Configuration
X Y
[1,] -0.189281738 -0.0189355171
[2,] 0.029592627 0.0433187831
[3,] 0.103524503 0.0239729400
[4,] 0.291068290 0.0149234806
[5,] 0.292742681 -0.0400237890
[6,] 0.222344247 -0.0435484505
[7,] 0.181619322 -0.0590318512
[8,] 0.055112150 -0.0672313024
[9,] -0.083360093 -0.0516471862
[10,] -0.094899473 -0.0507447190
[11,] -0.101073595 0.0135330548
[12,] -0.147012042 -0.0045122369
[13,] -0.157483228 -0.0047507502
[14,] -0.154671153 0.0022745793
[15,] -0.146665372 0.0066204770
[16,] -0.138702202 0.0040788669
[17,] -0.135991983 -0.0042341649
[18,] -0.138967991 -0.0116696972
[19,] -0.147198036 -0.0151300056
[20,] -0.154821657 -0.0116123547
[21,] -0.172223368 0.0001268433
[22,] -0.150280451 0.0134050233
[23,] -0.126763769 0.0226131185
[24,] -0.102893650 0.0294643374
[25,] -0.077947451 0.0350178375
[26,] -0.051682381 0.0387421906
[27,] -0.024668132 0.0410672890
[28,] 0.003771183 0.0422487283
[29,] 0.124174046 0.0207716628
[30,] 0.145969680 0.0178351614
[31,] 0.167130740 0.0151424861
[32,] 0.188055037 0.0127531300
[33,] 0.208889045 0.0106019815
[34,] 0.229635235 0.0089255399
[35,] 0.250139983 0.0082879256
[36,] 0.270933418 0.0107036636
[37,] -0.087792062 -0.0356799752
[38,] -0.087322415 -0.0180784465
[39,] -0.092567093 -0.0010343920
plotAllSpecimens(gpa$coords,mean=F)
plot PCA
PCA <- plotTangentSpace(gpa$coords,warpgrids = F)
pca %>%
group_by(id) %>%
mutate(hull = 1:n(), hull = factor(hull, chull(PC1, PC2)))%>%
arrange(as.numeric(hull))->pca
Unequal factor levels: coercing to characterbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vectorbinding character and factor vector, coercing into character vector
M<-mshape(gpa$coords)
PC<-PCA$pc.scores[,1:2]
preds<-shape.predictor(gpa$coords,x=PC,Intercept = FALSE,
pred1=c(-0.05,0.04))
GP<-gridPar(pt.size=0.5,tar.pt.size=0.5,n.col.cell = 50)
plotRefToTarget(M,preds$pred1,mag = 2,method = "vector",gridPars = GP)